home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / efs / efs-mvs.el.z / efs-mvs.el
Encoding:
Text File  |  1998-05-21  |  12.0 KB  |  362 lines
  1. ;; -*-Emacs-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;
  4. ;; File:         efs-mvs.el
  5. ;; Release:      $efs release: 1.15 $
  6. ;; Version:      #Revision: 1.4 $
  7. ;; RCS:          
  8. ;; Description:  MVS support for efs
  9. ;; Author:       Sandy Rutherford <sandy@math.ubc.ca, sandy@itp.ethz.ch>
  10. ;; Created:      Sat Nov 14 02:04:54 1992
  11. ;; Modified:     Sun Nov 27 18:37:54 1994 by sandy on gandalf
  12. ;; Language:     Emacs-Lisp
  13. ;;
  14. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  15.  
  16. ;;; This file is part of efs. See efs.el for copyright
  17. ;;; (it's copylefted) and warrranty (there isn't one) information.
  18.  
  19. ;;; --------------------------------------------------------
  20. ;;; MVS support
  21. ;;; --------------------------------------------------------
  22.  
  23. (provide 'efs-mvs)
  24. (require 'efs)
  25.  
  26. (defconst efs-mvs-version
  27.   (concat (substring "$efs release: 1.15 $" 14 -2)
  28.       "/"
  29.       (substring "#Revision: 1.4 $" 11 -2)))
  30.  
  31. ;; What's the MVS character set for valid partitioned data sets?
  32. ;; I'll guess [-A-Z0-9_$+]
  33.  
  34. ;; The top level directory in MVS contains partitioned data sets.
  35. ;; We will view these as directories. The data sets within each
  36. ;; partitioned data set will be viewed as files.
  37. ;;
  38. ;; In MVS an entry for a "sub-dir" may have the same name as a plain
  39. ;; file.  This is impossible in unix, so we retain the "dots" at the
  40. ;; end of subdir names, to distinuguish.
  41. ;; i.e. FOO.BAR --> /FOO./BAR
  42.  
  43. (efs-defun efs-send-pwd mvs (host user &optional xpwd)
  44.   ;; Broken quoting for PWD output on some MVS servers.
  45.   (let* ((result (efs-send-cmd host user '(pwd) "Getting EXPLORER PWD"))
  46.      (line (nth 1 result))
  47.      dir)
  48.     (and (car result)
  49.      (efs-save-match-data
  50.        (and (string-match " \"'?\\([0-9A-Z]+\\)'?\"" line)
  51.         (setq dir (substring line (match-beginning 1)
  52.                      (match-end 1))))))
  53.     (cons dir line)))
  54.  
  55. (efs-defun efs-fix-path mvs (path &optional reverse)
  56.   ;; Convert PATH from UNIX-ish to MVS.
  57.   (efs-save-match-data
  58.     (if reverse
  59.     (let ((start 0)
  60.           (res "/"))
  61.       ;; MVS has only files, some of which are partitioned
  62.       ;; into smaller files (partitioned data sets). We will
  63.       ;; assume that path starts with a partitioned dataset.
  64.       (while (string-match "\\." path)
  65.         ;; grab the dot too, because in mvs prefixes and plain
  66.         ;; files can have the same name.
  67.         (setq res (concat res (substring path start (match-end 0)) "/")
  68.           start (match-end 0)))
  69.       (concat res (substring path start)))
  70.       (let ((start 1)
  71.         res)
  72.     (while (string-match "/" path start)
  73.       (setq res (concat res (substring path start (match-beginning 0)))
  74.         start (match-end 0)))
  75.     (concat res (substring path start))))))
  76.         
  77. (efs-defun efs-fix-dir-path mvs (dir-path)
  78.   ;; Convert path from UNIX-ish to MVS for a DIR listing.
  79.   (cond
  80.    ((string-equal "/" dir-path)
  81.    " ")
  82.    (t (concat (efs-fix-path 'mvs dir-path) "*"))))
  83.  
  84. (efs-defun efs-allow-child-lookup mvs (host user dir file)
  85.   ;; Returns t if FILE in directory DIR could possibly be a subdir
  86.   ;; according to its file-name syntax, and therefore a child listing should
  87.   ;; be attempted.
  88.   ;; MVS file system is flat. Only partitioned data sets are "subdirs".
  89.   (efs-save-match-data
  90.     (string-match "\\.$" file)))
  91.  
  92. (efs-defun efs-parse-listing mvs (host user dir path &optional switches)
  93.   ;; Guesses the type of mvs listings.
  94.   (efs-save-match-data
  95.     (goto-char (point-min))
  96.     (cond
  97.      ((looking-at "Volume ")
  98.       (efs-add-listing-type 'mvs:tcp  host user)
  99.       (efs-parse-listing 'mvs:tcp host user dir path switches))
  100.  
  101.      ((looking-at "[-A-Z0-9_$.+]+ ")
  102.       (efs-add-listing-type 'mvs:nih host user)
  103.       (efs-parse-listing 'mvs:nih host user dir path switches))
  104.      
  105.      (t
  106.       ;; Since MVS works on a template system, return an empty hashtable.
  107.       (let ((tbl (efs-make-hashtable)))
  108.     (efs-put-hash-entry "." '(t) tbl)
  109.     (efs-put-hash-entry ".." '(t) tbl)
  110.     tbl)))))
  111.  
  112. (efs-defun efs-ls-dumb-check mvs (line host file path lsargs msg noparse
  113.                        noerror nowait cont)
  114.   ;; Because of the template structure of the MVS file system, empty
  115.   ;; directories are the same as non-existent.  It's better for us to treat
  116.   ;; them as empty.
  117.   (and (string-match "^550 " line)
  118.        (let ((parse (or (null noparse) (eq noparse 'parse)
  119.             (efs-parsable-switches-p lsargs t))))
  120.      (efs-add-to-ls-cache file lsargs "\n" parse)
  121.      (if parse
  122.          (efs-set-files file (let ((tbl (efs-make-hashtable)))
  123.                    (efs-put-hash-entry "." '(t) tbl)
  124.                    (efs-put-hash-entry ".." '(t) tbl)
  125.                    tbl)))
  126.      (if nowait
  127.          (progn
  128.            (if cont
  129.            (efs-call-cont cont "\n"))
  130.            t)
  131.        (if cont
  132.            (efs-call-cont cont "\n"))
  133.        "\n"))))
  134.  
  135. ;;;; ----------------------------------------------------
  136. ;;;; Support for the NIH FTP server.
  137. ;;;; ----------------------------------------------------
  138.  
  139. (efs-defun efs-parse-listing mvs:nih
  140.   (host user dir path &optional switches)
  141.   ;; Parse the current buffer which is assumed to be an MVS listing
  142.   ;; Based on the listing format of the NIH server. Hope that this format
  143.   ;; is widespread. If a directory doesn't exist, get a 426 ftp error.
  144.   ;; HOST = remote host name
  145.   ;; USER = user name
  146.   ;; DIR = directory as a remote full path
  147.   ;; PATH = directory in full efs-syntax
  148.   (let ((tbl (efs-make-hashtable))
  149.     (top-p (string-equal "/" dir))
  150.     ;; assume that everything top-level is a partitioned data set
  151.     )
  152.     (goto-char (point-min))
  153.     (efs-save-match-data
  154.       (while (re-search-forward "^[-A-Z0-9_$.+]+" nil t)
  155.     (efs-put-hash-entry
  156.      (concat (buffer-substring (match-beginning 0) (match-end 0))
  157.          (and top-p "."))
  158.      (list top-p) tbl)
  159.     (forward-line 1))
  160.       (efs-put-hash-entry "." '(t) tbl)
  161.       (or top-p (efs-put-hash-entry ".." '(t) tbl)))
  162.     tbl))
  163.  
  164. ;;; Tree dired support
  165.  
  166. (defconst efs-dired-mvs-re-exe
  167.   "^. [-A-Z0-9_$+]+\\.EXE "
  168.   "Regular expression to use to search for MVS executables.")
  169.  
  170. (or (assq  'mvs:nih efs-dired-re-exe-alist)
  171.     (setq efs-dired-re-exe-alist
  172.       (cons (cons 'mvs:nih efs-dired-mvs-re-exe)
  173.         efs-dired-re-exe-alist)))
  174.  
  175. (efs-defun efs-dired-insert-headerline mvs:nih (dir)
  176.   ;; MVS has no total line, so we insert a blank line for
  177.   ;; aesthetics.
  178.   (insert "\n")
  179.   (forward-char -1)
  180.   (efs-real-dired-insert-headerline dir))
  181.  
  182. (efs-defun efs-dired-manual-move-to-filename mvs:nih
  183.   (&optional raise-error bol eol)
  184.   ;; In dired, move to the first char of the filename on this line.
  185.   ;; This is the MVS version.
  186.   (or eol (setq eol (save-excursion (skip-chars-forward "^\n\r") (point))))
  187.   (let (case-fold-search)
  188.     (if bol
  189.     (goto-char bol)
  190.       (skip-chars-backward "^\n\r")
  191.       (setq bol (point)))
  192.     ;; MVS listings are pretty loose. Tough to tell when we've got a file line.
  193.     (if (and
  194.      (> (- eol bol) 2)
  195.      (progn
  196.        (forward-char 2)
  197.        (skip-chars-forward " \t")
  198.        (looking-at "[-A-Z0-9$_.+]+[ \n\r]")))
  199.     (point)
  200.       (goto-char bol)
  201.       (and raise-error (error "No file on this line")))))
  202.  
  203. (efs-defun efs-dired-manual-move-to-end-of-filename mvs:nih
  204.   (&optional no-error bol eol)
  205.   ;; Assumes point is at the beginning of filename.
  206.   ;; So, it should be called only after (dired-move-to-filename t).
  207.   ;; case-fold-search must be nil, at least for VMS.
  208.   ;; On failure, signals an error or returns nil.
  209.   ;; This is the MVS version.
  210.   (let ((opoint (point)))
  211.     (and selective-display
  212.      (null no-error)
  213.      (eq (char-after
  214.           (1- (or bol (save-excursion
  215.                 (skip-chars-backward "^\r\n")
  216.                 (point)))))
  217.          ?\r)
  218.      ;; File is hidden or omitted.
  219.      (cond
  220.       ((dired-subdir-hidden-p (dired-current-directory))
  221.        (error
  222.         (substitute-command-keys
  223.          "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
  224.       ((error
  225.         (substitute-command-keys
  226.          "File line is omitted. Type \\[dired-omit-toggle] to un-omit."
  227.          )))))
  228.     (skip-chars-forward "-A-Z0-9$_.+" eol)
  229.     (if (or (= opoint (point)) (not (memq (following-char) '(?\n ?\r ?\ ))))
  230.     (if no-error
  231.         nil
  232.       (error "No file on this line"))
  233.       (point))))
  234.  
  235. (efs-defun efs-dired-get-filename mvs:nih
  236.   (&optional localp no-error-if-not-filep)
  237.   (let ((name (efs-real-dired-get-filename localp no-error-if-not-filep))
  238.     (parsed (efs-ftp-path (dired-current-directory))))
  239.     (if (and name (string-equal "/" (nth 2 parsed)))
  240.     (concat name ".")
  241.       name)))
  242.  
  243. (efs-defun efs-dired-fixup-listing mvs:nih
  244.   (file path &optional switches wildcard)
  245.   ;; MVS listings have trailing spaces to 80 columns.
  246.   ;; Can lead to a mess after indentation.
  247.   (goto-char (point-min))
  248.   (while (re-search-forward " +$" nil t)
  249.     (replace-match "")))
  250.  
  251. ;;;; -------------------------------------------------------
  252. ;;;; Support for the TCPFTP MVS server
  253. ;;;; -------------------------------------------------------
  254. ;;;
  255. ;;;  For TCPFTP IBM MVS V2R2.1  Does it really work?
  256.  
  257. (efs-defun efs-parse-listing mvs:tcp
  258.   (host user dir path &optional switches)
  259.   ;; Parse the current buffer which is assumed to be an MVS listing
  260.   ;; Based on the listing format of the NIH server. Hope that this format
  261.   ;; is widespread. If a directory doesn't exist, get a 426 ftp error.
  262.   ;; HOST = remote host name
  263.   ;; USER = user name
  264.   ;; DIR = directory as a remote full path
  265.   ;; PATH = directory in full efs-syntax
  266.   (efs-save-match-data
  267.     (goto-char (point-min))
  268.     (and (looking-at "Volume ")
  269.      (let ((top-tbl (efs-make-hashtable))
  270.            (case-fold (memq 'mvs efs-case-insensitive-host-types))
  271.            tbl-list file dn fn tbl dir-p)
  272.        (forward-line 1)
  273.        (while (not (eobp))
  274.          (end-of-line)
  275.          (setq file (buffer-substring (point)
  276.                       (progn (skip-chars-backward "^ ")
  277.                          (point)))
  278.            dn path
  279.            dir-p (string-match "\\." file))
  280.          (efs-put-hash-entry file '(nil) top-tbl)
  281.          (if dir-p
  282.          (progn
  283.            (setq dir-p (1+ dir-p)
  284.              fn (substring file 0 dir-p))
  285.            (efs-put-hash-entry fn '(t) top-tbl)
  286.            (while dir-p
  287.              (setq dn (efs-internal-file-name-as-directory nil
  288.                    (concat dn fn))
  289.                file (substring file dir-p)
  290.                tbl (cdr (assoc dn tbl-list)))
  291.              (or tbl (setq tbl (efs-make-hashtable)
  292.                    tbl-list (cons (cons dn tbl) tbl-list)))
  293.              (efs-put-hash-entry file '(nil) tbl)
  294.              (setq dir-p (string-match "\\." file))
  295.              (if dir-p
  296.              (progn
  297.                (setq dir-p (1+ dir-p)
  298.                  fn (substring file 0 dir-p))
  299.                (efs-put-hash-entry fn '(t) tbl))))))
  300.          (forward-line 1))
  301.        (while tbl-list
  302.          (efs-put-hash-entry (car (car tbl-list)) (cdr (car tbl-list))
  303.                  efs-files-hashtable case-fold)
  304.          (setq tbl-list (cdr tbl-list)))
  305.        top-tbl))))
  306.            
  307. ;;; Tree Dired
  308.  
  309. (efs-defun efs-dired-manual-move-to-filename mvs:tcp
  310.   (&optional raise-error bol eol)
  311.   ;; In dired, move to the first char of the filename on this line.
  312.   ;; This is the MVS version.
  313.   (or eol (setq eol (save-excursion (skip-chars-forward "^\n\r") (point))))
  314.   (let (case-fold-search)
  315.     (if bol
  316.     (goto-char bol)
  317.       (skip-chars-backward "^\n\r")
  318.       (setq bol (point)))
  319.     (if (and (re-search-forward " [0-9][0-9]/[0-9][0-9]/[0-9][0-9] " eol t)
  320.          (progn
  321.            (goto-char eol)
  322.            (skip-chars-backward "-A-Z0-9$_.")
  323.            (char-equal (preceding-char) ?\ ))
  324.          (/= eol (point)))
  325.     (point)
  326.       (goto-char bol)
  327.       (and raise-error (error "No file on this line")))))
  328.  
  329. (efs-defun efs-dired-manual-move-to-end-of-filename mvs:tcp
  330.   (&optional no-error bol eol)
  331.   ;; Assumes point is at the beginning of filename.
  332.   ;; So, it should be called only after (dired-move-to-filename t).
  333.   ;; case-fold-search must be nil, at least for VMS.
  334.   ;; On failure, signals an error or returns nil.
  335.   ;; This is the MVS version.
  336.   (let ((opoint (point)))
  337.     (and selective-display
  338.      (null no-error)
  339.      (eq (char-after
  340.           (1- (or bol (save-excursion
  341.                 (skip-chars-backward "^\r\n")
  342.                 (point)))))
  343.          ?\r)
  344.      ;; File is hidden or omitted.
  345.      (cond
  346.       ((dired-subdir-hidden-p (dired-current-directory))
  347.        (error
  348.         (substitute-command-keys
  349.          "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
  350.       ((error
  351.         (substitute-command-keys
  352.          "File line is omitted. Type \\[dired-omit-toggle] to un-omit."
  353.          )))))
  354.     (skip-chars-forward "-A-Z0-9$_.+" eol)
  355.     (if (or (= opoint (point)) (not (memq (following-char) '(?\n ?\r ?\ ))))
  356.     (if no-error
  357.         nil
  358.       (error "No file on this line"))
  359.       (point))))
  360.     
  361. ;;; end of efs-mvs.el
  362.